SUBROUTINE PLOU

C	NOVEMBER 9, 69


	EQUIVALENCE(LIST,CURV)

	DIMENSION CURV(2,3000),IDP1(4000),
	1 HIST(0/63),DIF(3)

	COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
	1 DEBUG,TE(1),XP(1),YP(1),PARMAX,
	1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND

	COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO

	COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
	1 LSIDE,RSIDE,DTA,HYSTAB(1)

	INTEGER FI,FILEN,EWE,HIST,BITS,
	1 XIX,XI,FLINE,RSIDE,
	1 NUM2,NUM3,ID,PL,LIST5,X

	REAL LIST,RR,CL,SL,LEAP,LEA6,LEA3,CONST,FRAC,
	1 RX,RY,TEXT,TH,W1,W2,B1,B2,V1,V2,
	1 LV,LW,LB,D1,D2,CURV,T,X1,X2,A1,A2,C1,C2,MA,LC,
	1 D,B,DIF,B0,BB1,C3,C4
	DATA JJX/2/
	DIF(1)=0.0
	B0=0.0
	BB1=2**BITS-1
	RTO=6.
	IXYZ=0
	JAR=0
	JBR=0
	JX=0
	JY=0
	JPL=1

1	PLT=-1
1001	FORMAT(A1,8F)
1000	FORMAT(' D(ISPLAY), P(LOT) OR M(OVE)?  HORIZ. %, VERT. %,
	1 FOR CLEAR AREA L-R-U-D %   REV=1, INV=1'/)
	TYPE 1000
	ACCEPT 1001,WHICH,RLR,RUD,A,B,C,D,REV,RINV
C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
C-- D 0 0    0,50,50,0 CLEARS LOWER LFT QUAD. 50 100 100 50 UPR RT.
	IF(A+B+C+D.EQ.0)A=-1.
C  'N'= PLOT, BUT NO X

	IF(WHICH.NE.'D')GO TO 1002
	PLT=0
	JPL=3
C  DPY IS 1/3 SIZE OF PLOT.
	IPOG=1
	IF(NEWX.NE.NEWEND)CALL DPYSET(IPOG,IDP1,4000)
	CALL DPYBRT(6)
	CALL TYPLOC(-300,-611)
	GO TO 2000
1002	IF(WHICH.EQ.'P'.OR.WHICH.EQ.'N') CALL PLOTS(I)
	IF(WHICH.NE.'M')GO TO 2
C  MOVE PEN, L-R%, U-D%,  OLD LR%, UD% IF NEEDED
	IF(XLR.EQ.0)XLR=A/100.
	IF(YUD.EQ.0)YUD=B/100.
	JX=RTO*XLR*RLR*(RSIDE-LSIDE)
	JY=RTO*YUD*RUD*(LLINE-FLINE)
CC	CALL PLOT(JA,JB,3)
	GO TO 1000
CC	GOTO 1
2	IF(WHICH.EQ.'N')GO TO 2000

	CALL PLOT(10,0,3)
C  MAKES AN X
	CALL PLOT(-10,0,2)
	CALL PLOT(0,10,3)
	CALL PLOT(0,-10,2)
	CALL PLOT(0,0,3)

2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
	IF(RLR.EQ.0)RLR=100.
	IF(RUD.EQ.0)RUD=100.
	RLR=RLR/100.
	RUD=RUD/100.
	IF(NEWX.EQ.NEWEND)GO TO 2021
C NEXT KEEPS ORIG. SIZE FACTORS
	XLR=RLR
	YUD=RUD
2021	NEWX=NEWEND
	CONST=2.41
	IF((FLINE.EQ.0).AND.(LSIDE.EQ.0).AND.
	1 (LLINE.EQ.252).AND.(RSIDE.EQ.251)) CONST=CONST*.6667
CC	MB=10
501	IF(PLT.EQ.0)CALL AIVECT(-380,-200)
50	FORMAT(' DO YOU WANT THE FRAME ?'/)
60	TYPE 50
65	FORMAT(' LFT=',I4,'  RT=',I4,'  TOP=',I4,'  BOT=',I4/)
	ACCEPT 1001,ALFAB
CC	IF(ALFAB.EQ.'YES  ') GOTO 67
CC	GOTO 60
67	JA=LSIDE*RTO*RLR+JX
	JB=FLINE*RTO*RUD+JY
	JC=RSIDE*RTO*RLR+JX
	JD=LLINE*RTO*RUD+JY
	TYPE 65,JA,JD,JC,JB
C   OUTER COORDINATES
	JREV=JA+JC
	JINV=JB+JD
	IF(A)GO TO 681
	KA=JA+(JC-JA)*(A/100.)
	KB=JA+(JC-JA)*(B/100.)
	KC=JB+(JD-JB)*(C/100.)
	KD=JB+(JD-JB)*(D/100.)
	TYPE 65,KA,KB,KC,KD
C  CLEAR AREA COORDINATES
681	IF(ALFAB.EQ.'N') GOTO 68
	IF(PLT.EQ.0)GO TO 671
	CALL PLOT(JA,JB,3)
	CALL PLOT(JC,JB,2)
	CALL PLOT(JC,JD,2)
	CALL PLOT(JA,JD,2)
	CALL PLOT(JA,JB,2)
	GO TO 68
671	NA=(JC-JA)/3
	NB=(JD-JB)/3
	NC=JA/3-380
	ND=JB/3-200
	CALL AIVECT(NC,ND)
	CALL DPYBRT(2)
	CALL RVECT(NA,0)
	CALL RVECT(0,NB)
	CALL RVECT(-NA,0)
	CALL RVECT(0,-NB)
	JA=NB/4
	CALL RIVECT(0,JA)
	CALL RVECT(NA,0)
	CALL RIVECT(0,JA)
	CALL RVECT(-NA,0)
	CALL RIVECT(0,JA)
	CALL RVECT(NA,0)
	CALL AIVECT(NC,ND)
	JA=NA/4
	CALL RIVECT(JA,0)
	CALL RVECT(0,NB)
	CALL RIVECT(JA,0)
	CALL RVECT(0,-NB)
	CALL RIVECT(JA,0)
	CALL RVECT(0,NB)
	CALL AIVECT(-380,-200)
	IF(PLT.EQ.0)CALL DPYOUT(IPOG)
	CALL DPYBRT(6)
68	LEAP=(RR/2.+CONST)*RTO
	LEA6=LEAP/6.
	LEA3=LEAP/3.
	TH=(LEAP**2)*0.075

	DO 70 ID=0,63
70	HIST(ID)=0

	FRAC=64.0/FLOAT(2**BITS)
	DO 100 XIX=1,NEWEND
	ID=IFIX(LIST(5,XIX)*FRAC+0.5)
	IF(0.GT.ID) ID=0
	IF(63.LT.ID) ID=63
	HIST(ID)=HIST(ID)+1
100	CONTINUE

	DO 110 ID=1,63
110	HIST(ID)=HIST(ID)+HIST(ID-1)
	IF(HIST(63).NE.NEWEND) PAUSE 'ERROR IN PLOU'
	NUM2=IFIX(FLOAT(NEWEND)/3.+0.5)
	NUM3=IFIX(FLOAT(NEWEND)*2./3.+0.5)
	DO  121 ID=1,63
	IF(NUM2.GE.(HIST(ID)+HIST(ID-1))/2) DIF(2)=FLOAT(
	1 ID)/FRAC
121	IF(NUM3.GE.(HIST(ID)+HIST(ID-1))/2) DIF(3)=FLOAT(
	1 ID)/FRAC

	DO 123 I=0,1000
123	LIST5(I)=1

125	XI=1
	DO 120 XIX=1,NEWEND
	D=LIST(5,XIX)
	B=LIST(6,XIX)
	IF(((B+D.LT.B0+DIF(1)).OR.(B.GT.BB1-DIF(1)
	1 )).OR.(D.LT.DIF(1))) GOTO 120
	RX=LIST(1,XIX)*RTO
	RY=LIST(2,XIX)*RTO
	CL=LIST(3,XIX)*LEA6
	SL=LIST(4,XIX)*LEA6
	CURV(1,XI)=RX-SL
	CURV(2,XI)=RY+CL
	CURV(3,XI)=RX+SL
	CURV(4,XI)=RY-CL
	IF(((B+D.LT.B0+DIF(2)).OR.(B.GT.BB1-DIF(2)
	1 )).OR.(D.LT.DIF(2))) GOTO 118
	LIST5((XI-1)/2)=2
	IF(((B+D.LT.B0+DIF(3)).OR.(B.GT.BB1-DIF(3)
	1 )).OR.(D.LT.DIF(3))) GOTO 118
	LIST5((XI-1)/2)=3
118	XI=XI+2
120	CONTINUE

	DO 400 PL=1,3

	GOTO(140,130,130),PL
130	X=1
	DO 136 XI=1,EWE-3,2
	I=(XI-1)/2
	IF(LIST5(I).LT.PL) GOTO 136
	C1=CURV(1,XI)
	C2=CURV(2,XI)
	C3=CURV(3,XI)
	C4=CURV(4,XI)
	CURV(1,X)=C1
	CURV(2,X)=C2
	CURV(3,X)=C3
	CURV(4,X)=C4
	LIST5((X-1)/2)=LIST5(I)
	X=X+2
136	CONTINUE
	XI=X

140	EWE=XI+1
	FI=1
	LA=0
	DO 135 XIX=4,EWE,2
	LI=XIX-2

	IF((2.*CURV(1,LI)-CURV(1,XIX-3)-2.*CURV(1,XIX-1)+
	1 CURV(1,XIX))**2+(2.*CURV(2,LI)-CURV(2,XIX-3)-
	1 2.*CURV(2,XIX-1)+CURV(2,XIX))**2.LT.TH) GOTO 135

	LA=LI
	KI=FI+1
	IF(KI.EQ.LA) GOTO 200
	IF(PL.GT.1) GOTO 200

	CURV(1,FI)=CURV(1,FI)*1.5-CURV(1,KI)*0.5
	CURV(2,FI)=CURV(2,FI)*1.5-CURV(2,KI)*0.5
	CURV(1,LA)=CURV(1,LA)*1.5-CURV(1,LA-1)*0.5
	CURV(2,LA)=CURV(2,LA)*1.5-CURV(2,LA-1)*0.5

200	JA=RLR*CURV(1,FI)+.5
	JB=RUD*CURV(2,FI)+.5
	IF(IABS(JA-JAR).LT.4.AND.IABS(JB-JBR).LT.4)JCNT=JCNT+1
	JA=JA/JPL
	JB=JB/JPL
	IF(REV.NE.0)JA=JREV-JA
2004	IF(RINV.NE.0)JB=JINV-JB
	IF(PLT)GO TO 2001
2003	CALL RIVECT(JA-JAR,JB-JBR)
	JAR=JA
	JBR=JB
	GO TO 2002
2001	CALL PLOT(JA+JX,JB+JY,3)
2002	NI=LA-2
	JI=FI-1
	DO 210 I=JI,NI
	KI=I+1
	LI=KI+1
	MI=LI+1
	B1=CURV(1,LI)-CURV(1,KI)
	B2=CURV(2,LI)-CURV(2,KI)
	IF (I.EQ.JI) GOTO 202
	A1=CURV(1,KI)-CURV(1,I)
	A2=CURV(2,KI)-CURV(2,I)
	GOTO 204
202	A1=B1
	A2=B2
204	IF (I.EQ.NI) GOTO 206
	C1=CURV(1,MI)-CURV(1,LI)
	C2=CURV(2,MI)-CURV(2,LI)
	GOTO 208
206	C1=B1
	C2=B2
208	MA=A1**2+A2**2
	LB=B1**2+B2**2
	LC=C1**2+C2**2
	V1=A1*LB+B1*MA
	V2=A2*LB+B2*MA
	W1=B1*LC+C1*LB
	W2=B2*LC+C2*LB
	LV=SQRT(V1**2+V2**2)
	LW=SQRT(W1**2+W2**2)
	LB=SQRT(LB)
CC	IF (LV.LT.1.E-6.OR.LW.LT.1.E-6) PAUSE 'LV LW'
	AA=LB*.5858
	AB=AA/LW
	AA=AA/LV
	V1=V1*AA
	V2=V2*AA
	W1=W1*AB
	W2=W2*AB
	D1=B1-V1-W1
	D2=B2-V2-W2

	DO 220 K=1,8
	T=FLOAT(K)/8.
	T1=2.-T
	T2=3.-2.*T
	IX1=RLR*(CURV(1,KI)+(V1*T1+(W1+D1*T2)*T)*T+.5)
	IX2=RUD*(CURV(2,KI)+(V2*T1+(W2+D2*T2)*T)*T+.5)
	NA=2
	IF(A)GO TO 221
	IF(IX1.GE.KA.AND.IX1.LE.KB.AND.IX2.GE.KC.AND.IX2.
	1 LE.KD)NA=3
C   LEAVES CLEAR AREA
221	JA=IX1/JPL
	JB=IX2/JPL
	IF(REV.NE.0)JA=JREV-JA
	IF(RINV.NE.0)JB=JINV-JB
	IF(PLT.EQ.0)GO TO 220
	CALL PLOT(JA+JX,JB+JY,NA)
220	CONTINUE
2222	IF(PLT)GO TO 210
	IF(IXYZ)GO TO 211
	NC=JA-JAR
	ND=JB-JBR
	IF(NA.EQ.3)GO TO 222
	CALL RVECT(NC,ND)
	GO TO 223
222	CALL RIVECT(NC,ND)
223	JAR=JA
	JBR=JB
211	IXYZ=IXYZ-1
	IF(IXYZ.EQ.-3)IXYZ=0
C  DPY EVERY 5TH TIME.
210	CONTINUE

	IF(PLT.EQ.0)CALL DPYOUT(IPOG)
135	FI=LA+1
	GOTO(300,300,500),PL
300	TYPE 301
	ACCEPT 1001,WHICH
	IF(WHICH.EQ.'E'.OR.WHICH.EQ.'X')GO TO 500
	IF(WHICH.EQ.'R')RETURN
C  R=GO BACK FOR CHANGE BEFORE FINAL END.
301	FORMAT(' CHANGE THE PEN OR EXIT?'/)
	IF(PLT.EQ.0)GO TO 400
	JX=JX+JJX
	JY=JY+JJX
C  MOVES PEN JJX NOTCHES EACH TIME AROUND.
400	CONTINUE
500	IF(PLT)CALL PLOT(0,0,3)
	RETURN
212	FORMAT(2I)
	END